home *** CD-ROM | disk | FTP | other *** search
/ ShareWare OnLine 2 / ShareWare OnLine Volume 2 (CMS Software)(1993).iso / cad / acadfont.zip / MAKEFONT.LSP < prev    next >
Text File  |  1993-02-19  |  11KB  |  292 lines
  1. ;;  Makefont.lsp                                                                  
  2. ;;  by Brad Halls [76300,32] 
  3. ;;  Ruby & Associates, P.C.                               
  4. ;;  20245 West 12 Mile Road                                           
  5. ;;  Southfield, Michigan 48076                                        
  6. ;;  (313) 350-2400                                                    
  7. ;;                                                                    
  8. ;;  Note: The author has just been LAID OFF, and may now be
  9. ;;        reached at: 1237 Heitsch St., Waterford, MI 48328.
  10. ;;        (313) 673-1680. Happy day. Anybody hiring?
  11. ;;
  12. ;;  Prompts user for input from either digitizer or keyboard to       
  13. ;;  create a single character description of a customized font,       
  14. ;;  then appends that description to a file of the user's choice.     
  15. ;;  This program was published in CADENCE magazine in May, 1991.
  16. ;;  Freeware. Comments & suggestions welcome.
  17. ;;                                                                 
  18. ;;  
  19. ;;  VARIABLE              DATA TYPE        DESCRIPTION
  20. ;;   
  21. ;;  p1                    various          intget varible for program
  22. ;;  lastcommand           string           contains last command given
  23. ;;  newstring             string           string to be added to desc
  24. ;;  bytecount             int              # of bytes to describe char
  25. ;;  newpoint              list             most recent point selected
  26. ;;  oldpoint              list             point selected before newpoint
  27. ;;  x1                    int              x value of point vector
  28. ;;  y1                    int              y value of point vector
  29. ;;  charstring            string           character description for font
  30. ;;  filestrg              char             y or n to write to a file
  31. ;;  namestrg              string           name of file to append desc
  32. ;;  code                  int              ASCII code for header
  33. ;;  shapedesc             string           shape desc for header
  34. ;;  textfile              string           name of text file + ".shp"              
  35. ;;  file                  file             file to append desc
  36. ;;  bytes                 string           string for bytecount
  37. ;;  header                string           header line for shape
  38. ;;  thischar              char             char to write to file
  39. ;;  stringcount           int              position in charstring
  40. ;;  linecount             int              # of characters per line              
  41. ;;  cpd_mode              boolean          CPD mode descriptor
  42. ;; 
  43. ;; ------------------------------------------------------------------------;
  44.  
  45.    (defun pen_up ()
  46.      (if 
  47.        (or 
  48.          (= lastcommand "Up")   ;test1
  49.          (= lastcommand "Down") ;test2
  50.          (= cpd_mode 1)         ;test3
  51.        ) ;or
  52.            (prompt "\n\n*ERROR* Invalid pen command!\n") ;then
  53.  
  54.           (progn ;else
  55.             (prompt "\nThe pen is now up.")
  56.             (setq newstring "2,8,")
  57.             (setq charstring (strcat charstring newstring))
  58.             (setq bytecount (+ 2 bytecount)) 
  59.             (setq lastcommand "Up")
  60.           ) ;progn
  61.       ) ;if
  62.    ) ;defun
  63.  
  64.   ;----------------------------------------------------------------------;
  65.  
  66.    (defun pen_down ()
  67.      (if 
  68.        (or 
  69.          (= lastcommand "Up")   ;test1
  70.          (= lastcommand "Down") ;test2
  71.          (= cpd_mode 1)         ;test3
  72.        ) ;or
  73.            (prompt "\n\n*ERROR* Invalid pen command!\n") ;then
  74.   
  75.           (progn ;else
  76.             (prompt "\nThe pen is now down.")
  77.             (setq newstring "1,8,")
  78.             (setq charstring (strcat charstring newstring))
  79.             (setq bytecount (+ 2 bytecount)) 
  80.             (setq lastcommand "Down")
  81.           ) ;progn
  82.      ) ;if
  83.    ) ;defun
  84.  
  85.   ;----------------------------------------------------------------------;
  86.  
  87.    (defun start_cpd ()
  88.      (if (= cpd_mode 1)
  89.        (progn ;then
  90.          (prompt "\n")
  91.          (prompt "\n*ERROR* Already in CPD mode.")
  92.          (prompt "\n")
  93.         )
  94.         (progn ;else
  95.           (setq newstring "1,9,")
  96.           (setq charstring (strcat charstring newstring))
  97.           (prompt "\n\nContinuous points now being recorded.")
  98.           (prompt "\nEnter 'e' to end pen down mode.\n")
  99.           (setq bytecount (+ 2 bytecount))
  100.           (setq lastcommand "Start")
  101.           (setq cpd_mode 1)
  102.         )
  103.      );if
  104.    ); defun
  105.  
  106.   ;----------------------------------------------------------------------;
  107.  
  108.    (defun end_cpd ()
  109.      (if (= cpd_mode 0)
  110.        (progn ;then
  111.          (prompt "\n")
  112.          (prompt "\n*ERROR* Not in CPD mode!")
  113.          (prompt "\n")
  114.        )
  115.        (progn ;else
  116.          (setq newstring "(0,0),")
  117.          (setq charstring (strcat charstring newstring))
  118.          (prompt "\nPen down mode terminated.")
  119.          (setq bytecount (+ 2 bytecount))
  120.          (setq lastcommand "End")
  121.          (setq cpd_mode 0)
  122.        )
  123.      );if
  124.    ); defun
  125.  
  126.   ;----------------------------------------------------------------------;
  127.  
  128.    (defun quit_desc ()
  129.      (if (= cpd_mode 1)
  130.        (progn ;then
  131.          (prompt "\n")
  132.          (prompt "\n*ERROR* Still in CPD mode.")
  133.          (prompt "\n")
  134.        )
  135.        (progn ;else
  136.          (prompt "\n")
  137.          (prompt "\nCharacter definition complete.")
  138.          (setq charstring (strcat charstring "0"))
  139.          (setq bytecount (+ 1 bytecount))
  140.        )
  141.      );if
  142.    ); defun
  143.  
  144.   ;----------------------------------------------------------------------;
  145.  
  146.    (defun add_point ()
  147.      (if 
  148.        (or 
  149.          (= lastcommand "End") 
  150.          (= lastcommand "")
  151.          (and (= lastcommand "Point") (= cpd_mode 0))
  152.        ); or
  153.  
  154.        (progn ;then
  155.          (prompt "\n")
  156.          (prompt "\n*ERROR* Must indicate pen position!")
  157.          (prompt "\n")
  158.        )
  159.        (progn ;else
  160.          (setq newpoint p1)
  161.          (setq x1 (rtos (- (car newpoint) (car oldpoint))))
  162.          (setq y1 (rtos (- (cadr newpoint) (cadr oldpoint))))
  163.          (setq newstring (strcat "(" x1 "," y1 ")" "," )) 
  164.          (setq charstring (strcat charstring newstring))
  165.          (setq oldpoint p1)
  166.          (prompt "\nPoint recorded.")
  167.          (setq bytecount (+ 2 bytecount))
  168.          (setq lastcommand "Point")
  169.        )
  170.      );if
  171.    ); defun
  172.  
  173.   ;--------------------------------------------------------------;
  174.  
  175.    (defun write_file ()
  176.      (setq namestrg (getstring "\nName of file <no extension>: "))
  177.      (setq textfile (strcat namestrg ".shp"))
  178.      (prompt "\nASCII code for character <See AutoCAD manual p.510>: ")
  179.      (setq code (getstring))
  180.      (prompt "\nShape description <No spaces allowed>: ")
  181.      (setq shapedesc (getstring)) 
  182.      (setq file (open textfile "a"))
  183.      (setq bytes (rtos bytecount))
  184.      (setq header (strcat "*" code "," bytes "," shapedesc))
  185.      (write-line header file)
  186.  
  187.      (while (/= thischar "")
  188.        (setq thischar (substr charstring stringcount 1))
  189.        (if 
  190.          (and 
  191.            (> linecount 65) 
  192.            (= (substr charstring (+ 1 stringcount) 1) "(" )
  193.          )
  194.          (progn ;then
  195.            (write-char (ascii thischar) file)
  196.            (setq stringcount (+ 1 stringcount))
  197.            (write-char 10 file)
  198.            (setq linecount 0)
  199.          )
  200.          (progn ;else
  201.            (write-char (ascii thischar) file)
  202.            (setq stringcount (+ 1 stringcount))
  203.            (setq linecount (+ 1 linecount))
  204.          )
  205.        );if
  206.      );while
  207.  
  208.      (write-char 10 file)
  209.      (close file)
  210.    ); defun
  211.  
  212.   ;----------------------------------------------------------------------;
  213.  
  214.    (defun display_exit ()
  215.      (prompt "\nOK. Now end your drawing and select option number 7 from the")
  216.      (prompt "\nAutoCAD main menu to compile your font. If you don't already")
  217.      (prompt "\nhave one, you will need a header of the form <*0,4,font name>,")
  218.      (prompt "\n<above, below, modes,0> as the first 2 lines in your font file.")
  219.      (prompt "\nSee appendix B of the AutoCAD reference manual for further")
  220.      (prompt "\ninformation on custimizing shapes & fonts. Good luck!")
  221.      (prompt "\n")
  222.    ); defun
  223.  
  224.   ;----------------------------------------------------------------------;
  225.  
  226.    (defun display_intro ()
  227.  
  228.      (repeat 35 (prompt "\n")); clear screen
  229.      (prompt "\n--------------------------------------------------------------")
  230.      (prompt "\nWelcome to the Makefont.lsp character description program")
  231.      (prompt "\nCopyright (c) July 1990 by Brad Halls, Ruby & Associates P.C.")
  232.      (prompt "\nBefore you begin, be sure to set up your grid, snap, and units")
  233.      (prompt "\nso you get only integer values for point coordinates.")
  234.      (prompt "\nSuggested settings are as follows:")
  235.      (prompt "\n")
  236.      (prompt "\n  1. LIMITS: 50,50")
  237.      (prompt "\n  2. UNITS:  Decimal, set to 0 places after the decimal point.")
  238.      (prompt "\n  3. GRID:   ON, spacing set to one")
  239.      (prompt "\n  4. SNAP:   ON, spacing set to one")
  240.      (prompt "\n")
  241.      (prompt "\nYou should now see integer coordinates in the upper right hand")
  242.      (prompt "\nportion of your screen. If you do not, you must correct this or")
  243.      (prompt "\nthe font will not compile!")
  244.      (prompt "\n")
  245.      (prompt "\nThe following are available pen commands: ")
  246.      (prompt "\n")
  247.      (prompt "\n       Up...........Acivate pen up mode")
  248.      (prompt "\n       Down.........Activate pen down mode")
  249.      (prompt "\n       Start........Activate continuous pen down (CPD) mode")
  250.      (prompt "\n       End..........Terminate continuous pen down (CPD) mode")
  251.      (prompt "\n       Quit.........Terminate character description")
  252.      (prompt "\n")
  253.      (setq p1 (getpoint "\nStarting point? (It is a good idea to start at 0,0): "))
  254.      (prompt "\n")
  255.      (prompt "\nOK.")
  256.      (prompt "\nNow digitize each point along the letter path, and")
  257.      (prompt "\nbe sure to idicate pen position as you go.")
  258.      (prompt "\n")
  259.    ); defun
  260.  
  261.   ;----------------------------------------------------------------------;
  262.  
  263.    (defun c:go ()
  264.  
  265.      (setq p1 nil) (setq ptlist nil) (setq bytecount 0) (setq stringcount 1)
  266.      (setq linecount 0) (setq charstring "") (setq newstring "")
  267.      (setq lastcommand "") (setq thischar "empty") (setq cpd_mode 0)
  268.      (display_intro)
  269.      (setq oldpoint p1)
  270.      (while (/=  p1 "Quit")
  271.        (initget "Up Down Start End Quit")
  272.        (setq p1 (getpoint oldpoint "\nUp/Down/Start/End/Quit/<next point>: "))
  273.  
  274.        (cond 
  275.          ((= p1 "Up"   ) (pen_up   ))
  276.          ((= p1 "Down" ) (pen_down ))
  277.          ((= p1 "Start") (start_cpd))
  278.          ((= p1 "End"  ) (end_cpd  ))
  279.          ((= p1 "Quit" ) (quit_desc))
  280.          (T              (add_point))
  281.        ) ;cond
  282.  
  283.      ) ;while
  284.      (prompt (setq filestrg (getstring " Write to a file? ")))(terpri)
  285.      (if (or (= filestrg "y") (= filestrg "Y"))
  286.        (write_file)
  287.      ) ;if
  288.    (display_exit)
  289.    (princ)
  290.    ) ;program
  291.  
  292.   ;----------------------------------------------------------------------;